home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / PowerMacOberon 1.2 / Debugger / RTDT.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-08-07  |  16.8 KB  |  400 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 7 Aug 95
  5. InfoElems
  6. Alloc
  7. Syntax10.Scn.Fnt
  8. StampElems
  9. Alloc
  10. 7 Aug 95
  11. "Title": Run time debugger
  12. "Author": mah
  13. "Abstract": trap handler & lowlevel processor handling
  14. "Keywords": 
  15. "Version": 
  16. "From":  25.10.94 16:53:38
  17. "Until": 
  18. "Changes": 
  19. 10.12.94 separate codeseg for restart instead of removing one trap instr
  20. 26.1.95 separate debugging stack 
  21. 5.4.95 error fixed with local pointers on stack resp. in register
  22. ParcElems
  23. Alloc
  24. Syntax10b.Scn.Fnt
  25. Syntax10i.Scn.Fnt
  26. FoldElems
  27. Syntax10.Scn.Fnt
  28. Syntax10i.Scn.Fnt
  29.  read integer from reference information 
  30. Syntax10.Scn.Fnt
  31. Syntax10i.Scn.Fnt
  32.  read name from reference information 
  33. Syntax10.Scn.Fnt
  34. Syntax10i.Scn.Fnt
  35.  Copies an exception info structure (deep copy) 
  36. Syntax10.Scn.Fnt
  37. Syntax10i.Scn.Fnt
  38.  sets currently used length of the stack copy 
  39. Syntax10.Scn.Fnt
  40. Syntax10i.Scn.Fnt
  41.  mix new stack description with old one (reuse same memory where possible) 
  42. Syntax10.Scn.Fnt
  43. Syntax10i.Scn.Fnt
  44.  scan stack for procedure information 
  45. Syntax10.Scn.Fnt
  46. Syntax10i.Scn.Fnt
  47.  generate dummy code segment to skip initial bp 
  48. Syntax10i.Scn.Fnt
  49.  Graphical description 
  50. PictElems
  51. Alloc
  52. bc codeseg[2]
  53. codeseg[0]
  54. codeseg[1]
  55. codeseg[2]
  56. b target
  57.     bc target
  58. b target
  59. b next instr
  60.     all other
  61.  restart with instruction 'instr'
  62. instr = 
  63. instr
  64. b next instr
  65. b target
  66. LR=PC(Instr)+4
  67. bc codeseg[2](
  68. codeseg[0]0
  69. codeseg[1]*
  70. codeseg[2])i
  71. b target(
  72. v    bc target){
  73. b target(
  74. b next instr(
  75. f    all other(
  76.  restart with instruction 'instr'(
  77. instr = (
  78. instr(
  79. b next instr(
  80. b target(
  81. LR=PC(Instr)+4
  82. Syntax10i.Scn.Fnt
  83.  Get name of procedure starting at startPC 
  84. MODULE RTDT; (* Run time debugger: Traphandling; mah 25.10.94 (
  85. IMPORT Modules, Texts, SYS := SYSTEM, Sys, Oberon, Kernel, Input, Macintosh, Out;
  86. CONST
  87.     EnterDebugMode* = 255;                (* trap number to enter debugmode *)
  88.     Breakpoint = -1;                            (* trap number of a breakpoint *)
  89.     OtherTrap = -2;                            (* trap not controlled by debugger *)
  90.     SB = 2*2+1;                                (* static base register 2 *)
  91.     SP = 1*2+1;                                (* stack pointer register 1 *)
  92.     FP = 31*2+1;                            (* frame pointer register 31 *)
  93.     ib = 48000002H;
  94.     itw* = 7FE00008H;
  95.     inop* = 60000000H;
  96.     StackSize* = 50 * 1024;                    (* size of debugging stack *)
  97.     Proc*=POINTER TO ProcDesc;
  98.     ProcDesc*=RECORD 
  99.         up*: Proc;                            (* caller of myself *)
  100.         pc*, sp*: LONGINT;
  101.         name*: ARRAY 64 OF CHAR;
  102.         modName*: ARRAY 32 OF CHAR;
  103.         regs*: Sys.ExceptionInfo;
  104.         beginPC*, endPC*: LONGINT
  105.     END;
  106.     debugQ-: Kernel.Queue;                (* queue handled when a debuging step has been finished *)
  107.     startQ-: Kernel.Queue;                    (* queue handled when a debuging step is about to be started *)
  108.     LatestTrapInstr*: PROCEDURE (pc: LONGINT) : LONGINT;    (* up-call to fetch instruction at latest position pc *)
  109.     procs-: Proc;                            (* list of procedures currently on stack *)
  110.     debugMode: INTEGER;                    (* 0->off, 1->launching, 2->debugging *)
  111.     OldTrap: Sys.ExceptionHandler;            (* old system trap handler (Kernel.Trap) only valid if debugging=TRUE *)
  112.     traplevel: INTEGER;                        (* depth of trap recursion, only valid if debugging=TRUE *)
  113.     regs: Sys.ExceptionInfo;                    (* current register set of debugged program.*)
  114.     stack: RECORD
  115.                             (* stack copy *)
  116.         size: LONGINT;                        (* size of currently saved stack *)
  117.         adr: LONGINT;                        (* Adress of memory block for debug stack *)
  118.         p: POINTER TO ARRAY OF CHAR    (* Adress of memory block as pointer *)    
  119.     END;
  120.     codeseg: ARRAY 3 OF LONGINT;        (* dummy codesegment to start next step *)
  121.     dbgPar: Oberon.ParList;                    (* parameter of debug mode *)
  122.     MakeDataExecutable: PROCEDURE (base, len: LONGINT);
  123. PROCEDURE RInt (VAR refs: LONGINT; VAR k: LONGINT);
  124. VAR n : LONGINT; shift : SHORTINT; x : CHAR;
  125. BEGIN
  126.     shift := 0; n := 0; SYS.GET (refs, x); INC (refs);
  127.     WHILE ORD(x)>=128 DO
  128.         INC (n, ASH (ORD (x) MOD 128, shift));
  129.         INC (shift, 7);
  130.         SYS.GET (refs, x); INC (refs)
  131.     END;
  132.     k := n + ASH (ORD (x) MOD 64, shift) - ASH (ORD (x) DIV 64, shift) * 64
  133. END RInt;
  134. PROCEDURE RName (VAR refs:LONGINT; VAR name:ARRAY OF CHAR);
  135. VAR i  : INTEGER; ch : CHAR;
  136. BEGIN i := 0; REPEAT SYS.GET (refs, ch); name[i] := ch; INC (i); INC (refs) UNTIL ch = 0X
  137. END RName;
  138. PROCEDURE MoveRegs (VAR src, dest: Sys.ExceptionInfo);
  139. BEGIN
  140.     IF dest = NIL THEN NEW (dest); NEW (dest.spec); NEW (dest.reg); NEW (dest.fp) END;
  141.     dest.kind := src.kind;
  142.     dest.spec^ := src.spec^; dest.reg^ := src.reg^; dest.fp^ := src.fp^
  143. END MoveRegs;
  144. PROCEDURE SetStackLen (newSize: LONGINT);
  145. BEGIN
  146.     Kernel.RemoveStack (stack.adr);
  147.     IF newSize # 0 THEN Kernel.AddStack (stack.adr, stack.adr - newSize) END
  148. END SetStackLen;
  149. PROCEDURE SearchProc* (pc: LONGINT; VAR mod: Modules.Module; VAR refpos, refend, startpc, endpc: LONGINT);
  150. (* find mod, refstart, refend, startpc and endpc of a procedure given by a pc *)
  151.     m: Modules.Module;
  152.     ref, p: LONGINT;
  153.     ch: CHAR;
  154. BEGIN
  155.     m := Modules.modules; mod := NIL; refpos := -1;
  156.     WHILE (m # NIL) & ((pc < m.PC) OR (m.PC+m.codesize*4 < pc)) DO m := m.link END;
  157.     IF m # NIL THEN
  158.         mod := m; pc := (pc - m.PC) DIV 4;
  159.         ref := m.refs; refend := ref; p := 0; startpc := 0;
  160.         IF mod.refs # 0 THEN INC(refend, mod.refsize) END;
  161.         LOOP
  162.             IF ref >= refend THEN EXIT END;
  163.             SYS.GET(ref, ch); INC(ref);
  164.             IF ch = 0F8X THEN
  165.                 startpc := 4 * p; RInt(ref, p); endpc := 4 * p;
  166.                 IF p > pc THEN refpos := ref; EXIT END
  167.             END
  168.         END
  169. END SearchProc;
  170. PROCEDURE Mix (old: Proc);
  171. VAR p, tmp: Proc;
  172. BEGIN
  173.     (* invert old *)
  174.     p := old; old := NIL;
  175.     WHILE p # NIL DO tmp := p.up; p. up := old; old := p; p := tmp END;
  176.     p := procs;
  177.     WHILE (old # NIL) & (p # NIL) & (old.sp = p.sp) & (old.beginPC = p.beginPC) DO    (* same proc on same stack pos *)
  178.         tmp := p.up;
  179.         old.regs^ := p.regs^;
  180.         p^ := old^;
  181.         p.up := tmp;
  182.         p := p.up; old := old.up
  183.     END;
  184.     (* invert proc *)
  185.     p := procs; procs := NIL;
  186.     WHILE p # NIL DO tmp := p.up; p. up := procs; procs := p; p := tmp END
  187. END Mix;
  188. PROCEDURE ScanStack (pc, sp: LONGINT);
  189.     new, old: Proc;
  190.     ref, refend, p, fsize, psize, ralloc, falloc, calloc, nofFrames: LONGINT;
  191.     leaf: BOOLEAN;
  192.     mod : Modules.Module;
  193.     stackRegs: Sys.ExceptionInfo;
  194. BEGIN
  195.     nofFrames:=0; old := procs; procs := NIL;
  196.     MoveRegs (regs, stackRegs);
  197.     WHILE (sp <= Kernel.resumeSP) & (nofFrames < 64) DO
  198.         NEW (new); new.up := procs; procs := new;
  199.         new.pc := pc; new.sp := sp;
  200.         MoveRegs (stackRegs, new.regs);
  201.         SearchProc (pc, mod, ref, refend, new.beginPC, new.endPC);
  202.         IF mod = NIL THEN procs := procs.up; Mix (old); RETURN END;
  203.         COPY (mod.name, new.modName);
  204.         IF ref > 0 THEN
  205.             RInt (ref, fsize); RInt (ref, psize); RInt(ref, ralloc);
  206.             RInt (ref, falloc); RInt (ref, calloc);
  207.             SYS.GET (ref, leaf); INC (ref);
  208.             RName (ref, new.name);
  209.             new.regs.reg.R[FP] := new.regs.reg.R[FP] - Kernel.resumeSP + stack.adr;
  210.             SYS.GET(sp, sp);
  211.             IF leaf THEN pc := stackRegs.spec.LR ELSE SYS.GET(sp+8, pc) END;
  212.             p := sp - (31 - ralloc) * 4;
  213.             WHILE ralloc < 31 DO INC (ralloc); SYS.GET (p, stackRegs.reg.R[2*ralloc+1]); INC (p, 4) END;
  214.             INC (p, (-p) MOD 8);
  215.             WHILE falloc < 31 DO INC (falloc); SYS.GET (p, stackRegs.fp.R[2*falloc+1]); INC (p, 8) END;
  216.             IF calloc < 19 THEN SYS.GET (sp+4, stackRegs.spec.CR) END
  217.         ELSE
  218.             SYS.GET (sp, sp); SYS.GET (sp + 8, pc)
  219.         END;
  220.         IF (new.name = "Loop") & (new.modName = "Oberon") THEN Mix (old); RETURN END;
  221.         INC (nofFrames)
  222. END ScanStack;
  223. PROCEDURE GetTrapClass (mod: Modules.Module; pc: LONGINT) : INTEGER;
  224.         VAR pos, len, instr: LONGINT; trap : Modules.TrapDescPtr; 
  225.     BEGIN
  226.         SYS.GET (pc, instr);
  227.         pc := (pc - mod.PC) DIV 4;
  228.         pos := 0; len := 0; IF mod.traps # 0 THEN len := mod.noftraps END;
  229.         trap:= SYS.VAL (Modules.TrapDescPtr, mod.traps);
  230.         WHILE (pos < len) & (pc # trap.offset) DO
  231.             INC(pos);
  232.             trap:=SYS.VAL (Modules.TrapDescPtr, SYS.VAL (LONGINT, trap)+4)
  233.         END;
  234.         IF pos < len THEN
  235.             IF trap.trapno = EnterDebugMode THEN RETURN EnterDebugMode 
  236.             ELSIF instr # itw THEN RETURN trap.trapno
  237.             END
  238.         ELSIF instr # itw THEN RETURN OtherTrap
  239.         END;
  240.         RETURN Breakpoint
  241. END GetTrapClass;
  242. PROCEDURE SetStartSegment (VAR ctx: Sys.ExceptionInfo);
  243. (*---------------------------------------------------------------------------------------------
  244. ----------------------------------------------------------------------------------------------*)
  245. VAR target: LONGINT; s: SET; val: INTEGER;
  246. BEGIN
  247.     codeseg[0] := LatestTrapInstr (ctx.spec.PC);
  248.     s := SYS.VAL (SET, codeseg[0]) * {0..5, 30};
  249.     IF s = {1} THEN                                (* relative branch conditional *)
  250.         target := SYS.VAL (LONGINT, SYS.VAL (SET, codeseg[0]) * {16..29});
  251.         SYS.GET (SYS.ADR (target)+2, val);
  252.         target := val + ctx.spec.PC;
  253.         codeseg[0] := SYS.VAL (LONGINT, SYS.VAL (SET, codeseg[0]) * {0..15, 30, 31} + {28});
  254.         codeseg[2] := SYS.VAL (LONGINT, SYS.VAL (SET, ib) + SYS.VAL (SET, target))
  255.     ELSIF s = {1, 4} THEN                            (* relative branch unconditional *)
  256. Out.String ("relative branch unconditional$");
  257. HALT (31);
  258.         s := SYS.VAL (SET, codeseg[0]) * {6..29};
  259.         IF 6 IN s THEN s := s + {0..5} END;
  260.         target := ctx.spec.PC + SYS.VAL (LONGINT, s) - SYS.ADR (codeseg[0]);
  261.         codeseg[0] := SYS.VAL (LONGINT, SYS.VAL (SET, ib) + SYS.VAL (SET, target) * {6..29} - {30, 31});
  262.         ctx.spec.LR := ctx.spec.PC + 4
  263.     END;
  264.     codeseg[1] :=SYS.VAL (LONGINT, SYS.VAL (SET, ib) + SYS.VAL (SET, ctx.spec.PC+4)); 
  265.     ctx.spec.PC := SYS.ADR (codeseg[0]);
  266.     MakeDataExecutable (SYS.ADR (codeseg[0]), 12)
  267. END SetStartSegment;
  268. PROCEDURE Collect (VAR ctx: Sys.ExceptionInfo) : LONGINT;
  269.     sp, refpos, refend, dummy: LONGINT;
  270.     mod: Modules.Module;
  271.     class, x, y: INTEGER;
  272.     keys: SET;
  273. BEGIN
  274.     IF debugMode = 0 THEN RETURN -1 END;
  275.     SearchProc (ctx.spec.PC, mod, refpos, refend, dummy, dummy);
  276.     IF (ctx.kind # 2) OR (mod = NIL) THEN RETURN -1 END;
  277.     class := GetTrapClass (mod, ctx.spec.PC);
  278.     IF (class # EnterDebugMode) & (class # Breakpoint) THEN RETURN -1 END;
  279.     IF class = Breakpoint THEN
  280.         debugMode := 2;
  281.         dbgPar.text := Oberon.Par.text; dbgPar.pos := Oberon.Par.pos;
  282.         sp := ctx.reg.R[SP];
  283.         MoveRegs (ctx, regs);
  284.         stack.size := Kernel.resumeSP-sp; 
  285.         SYS.MOVE (sp, stack.adr - stack.size, stack.size);
  286.         SetStackLen (stack.size); 
  287.         ScanStack (regs.spec.PC, sp); 
  288.         debugQ.Handle;
  289.         Kernel.Resume (ctx);
  290.         RETURN 0
  291.     END;
  292.     startQ.Handle;
  293.     Oberon.Par.pos := dbgPar.pos; Oberon.Par.text := dbgPar.text;
  294.     MoveRegs (regs, ctx);
  295.     SYS.MOVE (stack.adr - stack.size, Kernel.resumeSP - stack.size, stack.size);
  296.     SetStartSegment (ctx);
  297.     RETURN 0
  298. END Collect;
  299. PROCEDURE Uninstall*;
  300. VAR dummy: Sys.ExceptionHandler;
  301. BEGIN 
  302.     dummy := Sys.InstallExceptionHandler (OldTrap); OldTrap := NIL;
  303.     SetStackLen (0); stack.p := NIL;
  304.     Kernel.RemoveStack (SYS.ADR (regs.reg.R[62]));
  305. END Uninstall;
  306. PROCEDURE Stop*;
  307. (* stop debugging (precondition: debugMode # 0) *)
  308. BEGIN
  309.     debugMode := 0;
  310.     debugQ.Handle
  311. END Stop;
  312. PROCEDURE Debugging* () : BOOLEAN;
  313. BEGIN RETURN debugMode = 2
  314. END Debugging;
  315. PROCEDURE Launching* () : BOOLEAN;
  316. BEGIN RETURN debugMode = 1
  317. END Launching;
  318. PROCEDURE Trap (ctx: Sys.ExceptionInfo) : LONGINT;
  319. (* TRAP handler *)
  320. VAR retval, sp: LONGINT; w: Texts.Writer; end: BOOLEAN; p: Proc;
  321. BEGIN
  322.     IF traplevel # 0 THEN
  323.         traplevel := 0;
  324.         Texts.OpenWriter (w);
  325.         Texts.WriteString (w, "RTD: recursive trap");Texts.WriteLn (w);
  326.         Texts.Append (Oberon.Log, w.buf);
  327.         IF debugMode # 0 THEN Stop END;
  328.         Kernel.Resume (ctx);
  329.         RETURN 0
  330.     END;
  331.     IF ctx.spec.PC = Macintosh.kbdIntPC THEN        (* kbd Interrupt *)
  332.         SYS.PUT (Macintosh.kbdIntPC, Macintosh.kbdIntInstr);
  333.         Macintosh.kbdIntPC := 0;
  334.         retval := OldTrap (ctx);
  335.         IF Debugging () THEN Stop END;
  336.         Kernel.Resume (ctx);
  337.         RETURN 0
  338.     END;
  339.     IF Debugging () OR Launching () THEN INC (traplevel); retval := Collect (ctx); DEC (traplevel) ELSE retval := -1 END;
  340.     IF retval # 0 THEN
  341.         MoveRegs (ctx, regs);
  342.         sp := ctx.reg.R[SP];
  343.         stack.size := Kernel.resumeSP - sp;
  344.         SYS.MOVE (sp, stack.adr - stack.size, stack.size); SetStackLen (stack.size);
  345.         ScanStack (regs.spec.PC, sp);
  346.         IF ~Debugging () THEN
  347.             p := procs;
  348.             WHILE p # NIL DO
  349.                 p.regs.reg.R[FP] := p.regs.reg.R[FP] - Kernel.resumeSP + stack.adr;
  350.                 p := p.up
  351.             END
  352.         END;
  353.         retval := OldTrap (ctx);
  354.         IF Debugging () THEN Stop END;
  355.         Kernel.Resume (ctx)
  356.     END;
  357.     RETURN 0
  358. END Trap;
  359. PROCEDURE Install*;
  360. BEGIN
  361.     IF OldTrap = NIL THEN
  362.         OldTrap := Sys.InstallExceptionHandler (Trap);
  363.         traplevel := 0; debugMode := 0;
  364.         NEW (regs); NEW (regs.spec); NEW (regs.reg); NEW (regs.fp);
  365.         Kernel.AddStack (SYS.ADR (regs.reg.R[62]), SYS.ADR (regs.reg.R[0]));
  366.         NEW (stack.p, StackSize); stack.adr := SYS.ADR (stack.p[0]) + StackSize
  367. END Install;
  368. PROCEDURE Prepare*;
  369. (* prepare debugging (precondition: debugMode = 0) *)
  370. BEGIN
  371.     debugMode := 1                            (* launch debugger mode *)
  372. END Prepare;
  373. PROCEDURE PC* () : LONGINT;
  374. BEGIN RETURN regs.spec.PC
  375. END PC;
  376. PROCEDURE PopProc*;
  377. BEGIN IF procs # NIL THEN procs := procs.up END
  378. END PopProc;
  379. PROCEDURE FindProc* (startPC: LONGINT; VAR name: ARRAY OF CHAR);
  380.     i, j : LONGINT;
  381.     mod  : Modules.Module;
  382.     r, rr: LONGINT;
  383.     n    : ARRAY 64 OF CHAR;
  384. BEGIN
  385.     name[0] := 0X;
  386.     SearchProc (startPC, mod, r, rr, i, i);
  387.     IF mod = NIL THEN RETURN END;
  388.     RInt(r, i); RInt(r, i); RInt(r, i); RInt(r, i); RInt(r, i); INC(r);
  389.     RName (r, n);
  390.     COPY (mod.name, name);
  391.     i := 0; WHILE name[i] # 0X DO INC (i) END;
  392.     name[i] := '.';
  393.     j := 0; WHILE n[j] # 0X DO name[i+j+1] := n[j]; INC (j) END;
  394.     name[i+j+1] := 0X
  395. END FindProc;
  396. BEGIN
  397.     debugQ.Init; startQ.Init; OldTrap := NIL; NEW (dbgPar);
  398.     Sys.Assign ("MakeDataExecutable", SYS.ADR (MakeDataExecutable))
  399. END RTDT.
  400.